home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_tkcvs.idb / usr / freeware / lib / tkcvs / cvs.tcl.z / cvs.tcl
Encoding:
Text File  |  1999-04-16  |  21.8 KB  |  898 lines
  1. #
  2. # TCL Library for tkCVS
  3. #
  4.  
  5. #
  6. # $Id: cvs.tcl,v 1.41 1996/05/25 02:54:58 del Exp $
  7. # 
  8. # Contains procedures used in interaction with CVS.
  9. #
  10.  
  11. proc cvs_notincvs {} {
  12.   cvserror "This directory is not in CVS.\nPlease import it first."
  13. }
  14.  
  15. proc cvs_incvs {} {
  16.   cvserror "You cant do that here because this directory is already in CVS."
  17. }
  18.  
  19. proc cvs_remote_bad {} {
  20.   cvserror "You cant do that with a remote CVS repository."
  21. }
  22.  
  23. proc cvs_remove args {
  24. #
  25. # This deletes a file from the directory and the repository,
  26. # asking for confirmation first.
  27. #
  28.   global cvs
  29.   global incvs
  30.   # need access to cvscfg(rm_cmd) and cvscfg(rm_flags) 
  31.   # -sj
  32.   global cvscfg
  33.  
  34.   if {$args == "{}"} {
  35.     cvserror "Please select some files to delete first!"
  36.     return
  37.   }
  38.  
  39.   # modified to provide a more detailed warning  
  40.   # and use the cvscfg(rm_cmd) and cvscfg(rm_flags) 
  41.   # -sj
  42.   set mess ""
  43.   if {$incvs} {
  44.     set mess "WARNING!!! This will modify"
  45.     set mess "$mess the contents of the CVS"
  46.     set mess "$mess repository!!!!"
  47.   }
  48.   set mess "$mess\n\nYou are about to remove these"
  49.   set mess "$mess files:"
  50.   if { [ are_you_sure $mess $args ] == 1 } {
  51.     set results ""
  52.     foreach file $args {
  53.       eval exec $cvscfg(rm_cmd) $cvscfg(rm_flags) $file
  54.       if {$incvs} {
  55.         catch {eval "exec $cvs remove $file"} view_this
  56.         if { $view_this != "" } {set results "$results\n$view_this" }
  57.       }
  58.     }
  59.     view_output "CVS Delete" $results
  60.     setup_dir
  61.   }
  62. }
  63.  
  64. proc cvs_add args {
  65. #
  66. # This adds a file to the repository.
  67. #
  68.   global cvs
  69.   global incvs
  70.  
  71.   if {! $incvs} {
  72.     cvs_notincvs
  73.     return 1
  74.   }
  75.  
  76.   if {$args == "{}"} {
  77.     set mess "This will add all new files!"
  78.   } else {
  79.     set mess "This will add these files:\n\n"
  80.     foreach file $args {
  81.       set mess "$mess   $file\n"
  82.     }  
  83.   }
  84.  
  85.   set mess "$mess\nAre you sure?"
  86.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  87.  
  88.   if {$confirm == 0} {
  89.     if {$args == "{}"} {
  90.       foreach file [glob -nocomplain *] {
  91.         catch {eval "exec $cvs add $file"} view_this
  92.         # Probably don't need to see the output, but you can uncomment this
  93.         # line if you like.
  94.         # view_output "CVS Add" $view_this
  95.       }
  96.     } else {
  97.       foreach file $args {
  98.         catch {eval "exec $cvs add $file"} view_this
  99.         # view_output "CVS Add" $view_this
  100.       }
  101.     }
  102.   }
  103. }
  104.  
  105. proc cvs_diff args {
  106. #
  107. # This diffs a file with the repository.
  108. #
  109.   global cvs
  110.   global incvs
  111.  
  112.   if {! $incvs} {
  113.     cvs_notincvs
  114.     return 1
  115.   }
  116.  
  117.   if {$args == "{}"} {
  118.     foreach file [glob -nocomplain *] {
  119.       catch {eval "exec tkdiff -C $file &"} view_this
  120.     }
  121.   } else {
  122.     foreach file $args {
  123.       catch {eval "exec tkdiff -C $file &"} view_this
  124.     }
  125.   }
  126. }
  127.  
  128. proc cvs_diff_r {rev1 rev2 args} {
  129. #
  130. # This diffs a file with the repository, using two revisions or tags.
  131. #
  132.   global cvs
  133.   global incvs
  134.  
  135.   if {! $incvs} {
  136.     cvs_notincvs
  137.     return 1
  138.   }
  139.   if {$rev1 == {} || $rev2 == {}} {
  140.     cvserror "Must have two revision numbers for this function!"
  141.     return 1
  142.   }
  143.  
  144.   if {$args == "{}"} {
  145.     foreach file [glob -nocomplain *] {
  146.       catch {eval "exec tkdiff -C $rev1 -C $rev2 $file &"} view_this
  147.     }
  148.   } else {
  149.     foreach file $args {
  150.       catch {eval "exec tkdiff -C $rev1 -C $rev2 $file &"} view_this
  151.     }
  152.   }
  153. }
  154.  
  155. proc cvs_view_r {rev args} {
  156. #
  157. # This views a specific revision of a file in the repository.
  158. #
  159.   global cvs
  160.   global incvs
  161.  
  162.   if {! $incvs} {
  163.     cvs_notincvs
  164.     return 1
  165.   }
  166.  
  167.   if {$args == "{}"} {
  168.     foreach file [glob -nocomplain *] {
  169.       catch {eval "exec $cvs update -p -r $rev $file 2>/dev/null"} view_this
  170.       view_output "CVS View" $view_this
  171.     }
  172.   } else {
  173.     foreach file $args {
  174.       catch {eval "exec $cvs update -p -r $rev $file 2>/dev/null"} view_this
  175.       view_output "CVS View" $view_this
  176.     }
  177.   }
  178. }
  179.  
  180. proc cvs_logcanvas args {
  181. #
  182. # This looks at a log from the repository.
  183. #
  184.   global cvs
  185.   global incvs
  186.  
  187.   if {! $incvs} {
  188.     cvs_notincvs
  189.     return 1
  190.   }
  191.  
  192.   if {$args == "{}"} {
  193.     set filelist "."
  194.   } else {
  195.     set filelist $args
  196.   }
  197.   foreach file $filelist {
  198.     catch {eval "exec $cvs log $file"} view_this
  199.     # New style file log viewer
  200.     new_logcanvas $file $view_this
  201.   }
  202. }
  203.  
  204. proc cvs_log args {
  205. #
  206. # This looks at a log from the repository.
  207. # This is an old style file log with just the output from cvs log.
  208. #
  209.   global cvs
  210.   global incvs
  211.   # need access to cvscfg (ldetail)
  212.   # -sj
  213.   global cvscfg
  214.  
  215.   if {! $incvs} {
  216.     cvs_notincvs
  217.     return 1
  218.   }
  219.  
  220.   if {$args == "{}"} {
  221.     set filelist "."
  222.   } else {
  223.     set filelist $args
  224.   }
  225.   # modified to allow for varying level of detail
  226.   # -sj
  227.   if {$cvscfg(cvsver) < 1.3} {
  228.     set cvscfg(ldetail) "verbose"
  229.   }
  230.  
  231.   if { $cvscfg(ldetail) == "verbose" } {
  232.     set commandline "exec $cvs log $filelist"
  233.   } elseif { $cvscfg(ldetail) == "last" || $cvscfg(ldetail) == "summary"} {
  234.     set commandline "exec cvs -l -n log -l $filelist "
  235.     set commandline "$commandline | awk { BEGIN {LM=-1000}\n"
  236.     set commandline "$commandline \$0 ~ /----------------------------/"
  237.     set commandline "$commandline {LM=0; printf(\"\\n--------------------\\n\");}"
  238.     set commandline "$commandline \$0 ~ /\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\="
  239.     set commandline "$commandline\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=\\=/ "
  240.     set commandline "$commandline {LM=0; printf(\"\\n\");}"
  241.     set commandline "$commandline {if (LM \=\= 1) printf(\"%s \", \$0);"
  242.     set commandline "$commandline if (LM \>\= 3) printf(\"%s \", \$0);"
  243.     set commandline "$commandline LM\+\+;}} "
  244.     set commandline "$commandline | tail \+2"
  245.     if {$cvscfg(ldetail) == "last" } {
  246.       set commandline "$commandline | head \-2 "
  247.     }
  248.   }
  249.  
  250.   # puts stderr "command line is $commandline"
  251.   catch { eval $commandline } view_this
  252.   view_output "CVS Log" $view_this
  253. }
  254.  
  255. proc cvs_commit {revision comment args} {
  256. #
  257. # This commits changes to the repository.
  258. #
  259. # The parameters work differently here -- args is a list.  The first
  260. # element of args is a list of file names.  This is because I can't
  261. # use eval on the parameters, because comment contains spaces.
  262. #
  263.   global cvs
  264.   global cvscfg
  265.   global incvs
  266.   global filelist
  267.  
  268.   # puts stderr "Revision = $revision"
  269.   # puts stderr "Comment  = $comment"
  270.  
  271.   if {! $incvs} {
  272.     cvs_notincvs
  273.     return 1
  274.   }
  275.  
  276.   if {$comment == ""} {
  277.     cvserror "You must enter a comment!"
  278.     return 1
  279.   }
  280.  
  281.   if {$args == "{}"} {
  282.     set filelist "."
  283.     if {$cvscfg(cvsver) < 1.3} {
  284.       # cosmetic cleanup
  285.       # -sj
  286.       set errstr "You must select files to be committed with CVS version"
  287.       set errstr "$errstr $cvscfg(cvsver)."
  288.       set errstr "$errstr\n\nEither select a list of files or upgrade
  289.       set errstr "$errstr your CVS to version 1.3"
  290.       cvserror "$errstr"
  291.       return
  292.     }
  293.   } else {
  294.     set filelist [lindex $args 0]
  295.   }
  296.  
  297.   # changed the message to be a little more explicit.
  298.   # -sj
  299.   set commit_output ""
  300.   if { $filelist == "." } {
  301.       set mess "This will commit your changes to ** ALL ** files in"
  302.       set mess "$mess and under this directory.\n\nAre you sure?"
  303.   } else {
  304.       foreach file $filelist {
  305.       set commit_output "$commit_output\n$file"
  306.       }
  307.       set mess "This will commit your changes to:$commit_output\n\nAre you sure?"
  308.   }
  309.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  310.  
  311.   set commit_output ""
  312.   if {$confirm == 0} {
  313.     if {$revision != ""} {
  314.       if {$cvscfg(cvsver) < 1.3} {
  315.         foreach file $filelist {
  316.           # puts stderr "1 Committing $file"
  317.           catch {exec $cvs commit -f -r $revision -m "$comment" $file} \
  318.             commit_tmp
  319.           set commit_output "$commit_output\n$commit_tmp"
  320.         }
  321.       } else {
  322.         foreach file $filelist {
  323.           # puts stderr "2 Committing $file"
  324.           catch {exec $cvs commit -r $revision -m "$comment" $file} \
  325.             commit_tmp
  326.           set commit_output "$commit_output\n$commit_tmp"
  327.         }
  328.       }
  329.     } else {
  330.       if {$cvscfg(cvsver) < 1.3} {
  331.         foreach file $filelist {
  332.           # puts stderr "3 Committing $file"
  333.           catch {exec $cvs commit -f -m "$comment" $file} \
  334.             commit_tmp
  335.           set commit_output "$commit_output\n$commit_tmp"
  336.         }
  337.       } else {
  338.         foreach file $filelist {
  339.           # puts stderr "4 Committing $file"
  340.           catch {exec $cvs commit -m "$comment" $file} \
  341.             commit_tmp
  342.           set commit_output "$commit_output\n$commit_tmp"
  343.         }
  344.       }
  345.     }
  346.     view_output "CVS Commit" $commit_output
  347.   }
  348. }
  349.  
  350. proc cvs_tag {tagname branch args} {
  351. #
  352. # This tags a file in a directory.
  353. #
  354.   global cvs
  355.   global cvscfg
  356.   global incvs
  357.   global filelist
  358.  
  359.   if {$cvscfg(cvsver) < 1.3} {
  360.     cvserror "This function is not supported in CVS version $cvscfg(cvsver).
  361.  
  362. Please upgrade your CVS to version 1.3"
  363.     return
  364.   }
  365.  
  366.   if {! $incvs} {
  367.     cvs_notincvs
  368.     return 1
  369.   }
  370.  
  371.   if {$tagname == ""} {
  372.     cvserror "You must enter a tag name!"
  373.     return 1
  374.   }
  375.  
  376.   set cmd_options ""
  377.  
  378.   if {$cvscfg(cvsver) > 1.3} {
  379.     set cmd_options "$cmd_options -F"
  380.   }
  381.  
  382.   if {$args == "{}"} {
  383.     set filelist "."
  384.   } else {
  385.     set filelist $args
  386.   }
  387.  
  388.   if {$branch == "yes"} {
  389.     set cmd_options "$cmd_options -b"
  390.     catch {eval "exec $cvs tag $cmd_options $tagname $filelist"} tag_output
  391.     catch {eval "exec $cvs update -r $tagname $filelist"} tag_output2
  392.     set tag_output "$tag_output\n\n$tag_output2"
  393.   } else {
  394.     catch {eval "exec $cvs tag $cmd_options $tagname $filelist"} tag_output
  395.   }
  396.   view_output "CVS Tag" $tag_output
  397. }
  398.  
  399. proc cvs_update {tagname args} {
  400. #
  401. # This updates the files in the current directory.
  402. #
  403.   global cvs
  404.   global incvs
  405.  
  406.   if {! $incvs} {
  407.     cvs_notincvs
  408.     return 1
  409.   }
  410.  
  411.   if {$args == "{}"} {
  412.     set filelist "."
  413.   } else {
  414.     set filelist $args
  415.   }
  416.  
  417.   # changed the message to be a little more explicit.
  418.   # -sj
  419.   if { $filelist == "." } {
  420.       set mess "You are about to download from"
  421.       set mess "$mess the repository to your local"
  422.       set mess "$mess filespace ** ALL ** files which"
  423.       set mess "$mess have changed in it."
  424.   } else {
  425.       set mess "You are about to download from"
  426.       set mess "$mess the repository to your local"
  427.       set mess "$mess filespace these files which"
  428.       set mess "$mess have changed:\n"
  429.       regsub -all {" "} $filelist {"\\n\\t"} tmp
  430.       set mess "$mess\n$tmp"
  431.   }
  432.   set mess "$mess\n\nAre you sure?"
  433.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  434.  
  435.   if {$confirm == 0} {
  436.     # modified to allow putting the comandline executed to the console.
  437.     # more to support debugging than anything else.
  438.     # -sj
  439.     set str [join $filelist "" ]
  440.     if {$tagname == ""} {
  441.       set commandline "exec $cvs update $str "
  442.       catch {eval $commandline} view_this
  443.     } else {
  444.       set commandline "exec cvs update -r $tagname $str"
  445.       catch {eval $commandline} view_this
  446.     }
  447.     view_output "CVS Update" $view_this
  448.     setup_dir
  449.   }
  450. }
  451.  
  452. proc cvs_join {localfile branchver} {
  453. #
  454. # This does a join (merge) of the branchver revision of localfile to the
  455. # head revision.
  456. #
  457.   global cvs
  458.   global incvs
  459.  
  460.   if {! $incvs} {
  461.     cvs_notincvs
  462.     return 1
  463.   }
  464.  
  465.   set mess "This will merge revision $branchver to the head revision of $localfile
  466.  
  467. Are you sure?"
  468.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  469.  
  470.   if {$confirm == 0} {
  471.     catch {eval "exec $cvs update -j$branchver $localfile"} view_this
  472.     view_output "CVS Merge" $view_this
  473.     setup_dir
  474.   }
  475. }
  476.  
  477. proc cvs_delta {localfile ver1 ver2} {
  478. #
  479. # This merges the changes between ver1 and ver2 into the head revision.
  480. #
  481.   global cvs
  482.   global incvs
  483.  
  484.   if {! $incvs} {
  485.     cvs_notincvs
  486.     return 1
  487.   }
  488.  
  489.   if {$ver1 == {} || $ver2 == {}} {
  490.     cvserror "Must have two revision numbers for this function!"
  491.     return 1
  492.   }
  493.   set mess "This will merge the changes between revision $ver1 and $ver2 (if $ver1 > $ver2 the changes are removed) to the head revision of $localfile
  494.  
  495. Are you sure?"
  496.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  497.  
  498.   if {$confirm == 0} {
  499.     catch {eval "exec $cvs update -j$ver1 -j$ver2 $localfile"} view_this
  500.     view_output "CVS Merge" $view_this
  501.     setup_dir
  502.   }
  503. }
  504.  
  505. proc cvs_status args {
  506. #
  507. # This does a status report on the files in the current directory.
  508. #
  509.   global cvs
  510.   global incvs
  511.   global cvscfg
  512.  
  513.   # provided as convient place holders.
  514.   # -sj
  515.   set global_options ""
  516.   set cmd_options ""
  517.  
  518.   if {! $incvs} {
  519.     cvs_notincvs
  520.     return 1
  521.   }
  522.  
  523.   # added recurse capability to reports.
  524.   # -sj
  525.   # if recurse option is false or there are selected files, don't recurse
  526.   if { ( $cvscfg(recurse) == "false" ) || ( $args != {} ) } { 
  527.     set cmd_options "$cmd_options -l"
  528.   }
  529.  
  530.   if {$args == "{}"} {
  531.     set filelist "."
  532.   } else {
  533.     set filelist $args
  534.   }
  535.  
  536.   # Additional support added for 1.4
  537.   # -sj
  538.   if {$cvscfg(cvsver) < 1.3} {
  539.     set cmd_options ""
  540.     set cvscfg(rdetail) "verbose"
  541.   } elseif { $cvscfg(cvsver) < 1.4} {
  542.     set global_options "$global_options -q"
  543.   } else {
  544.     set global_options "$global_options -Q"
  545.   }
  546.   # added to support verious levels of verboseness. Ideas derived and some of the 
  547.   # awk expressions derived from GIC.
  548.   # -sj
  549.   if { $cvscfg(rdetail) == "verbose" } {
  550.       set commandline "exec $cvs $global_options status $cmd_options $filelist"
  551.   } elseif { $cvscfg(rdetail) == "summary" } {
  552.       set commandline "exec $cvs $global_options status $cmd_options $filelist | "
  553.       set commandline "$commandline awk {\$3 ~ /Status:/ "
  554.       set commandline "$commandline { printf(\"%s %s %s %s \\t%s\\n\", \$4, \$5, \$6, \$7, \$2);}}"
  555.   } elseif { $cvscfg(rdetail) == "terse" } {
  556.       set commandline "exec $cvs $global_options status $cmd_options $filelist | "
  557.       set commandline "$commandline awk {\$3 ~ /Status:/ {if (\$4 != \"Up-to-date\") "
  558.       set commandline "$commandline { printf(\"%s %s %s %s \\t%s\\n\", \$4, \$5, \$6, \$7, \$2);}}} "
  559.   }
  560.   # puts stderr "command line is $commandline"
  561.   catch { eval $commandline } view_this
  562.   if { $view_this == "" } {
  563.     set mess "Everything is Up-to-date."
  564.     set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK ]
  565.   } else {
  566.     view_output "CVS Status" $view_this
  567.   }
  568. }
  569.  
  570. proc cvs_check {} {
  571. #
  572. # This does a cvscheck on the files in the current directory.
  573. #
  574.   global cvs
  575.   global incvs
  576.   global cvscfg
  577.  
  578.   if {! $incvs} {
  579.     cvs_notincvs
  580.     return 1
  581.   }
  582.  
  583.   catch {exec cvscheck $cvscfg(checkrecursive)} view_this
  584.   view_output "CVS Check" $view_this
  585. }
  586.  
  587. proc cvs_checkout {mcode revision} {
  588. #
  589. # This checks out a new module into the current directory.
  590. #
  591.   #puts "Entered cvs_checkout, mcode=$mcode, revision=$revision"
  592.   global cvs
  593.   global incvs
  594.  
  595.   if {$incvs} {
  596.     set mess "You are already in a CVS controlled directory.  Are you"
  597.     set mess "$mess sure that you want to check out another module in"
  598.     set mess "$mess to this directory?"
  599.     set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  600.     if {$confirm} { return 1 }
  601.   }
  602.  
  603.   set mess "This will check out $mcode from CVS.\nAre you sure?"
  604.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  605.   #puts "From cvs_checkout, mcode=$mcode  pwd=[exec pwd]"
  606.   if {$confirm == 0} {
  607.     feedback_cvs "Checking out module $mcode, please wait"
  608.     if {$revision == {}} {
  609.       catch {exec $cvs co $mcode} view_this
  610.     } else {
  611.       catch {exec $cvs co -r $revision $mcode} view_this
  612.     }
  613.     feedback_cvs ""
  614.     view_output "CVS Checkout" $view_this
  615.     setup_dir
  616.   }
  617. }
  618.  
  619. proc cvs_filelog {mcode filename} {
  620. #
  621. # This looks at a revision log of a file from the repository without
  622. # checking it out.
  623. #
  624.   global cvs
  625.   global cvsroot
  626.   global location
  627.   global cvscfg
  628.   
  629.   feedback_cvs "Executing rlog command, please wait"
  630.   catch {exec rlog $cvsroot/$location($mcode)/$filename} view_this
  631.   feedback_cvs ""
  632.  
  633.   # Old style file log with just the output from cvs log.
  634.   # view_output "CVS File Log" $view_this
  635.  
  636.   # New style file log viewer
  637.   new_logcanvas "no file" $view_this
  638. }
  639.  
  640. proc rcs_fileview {filename revision} {
  641. #
  642. # This views an RCS file in the repository.
  643. #
  644.   if {$cvscfg(remote)} {
  645.     cvs_remote_bad
  646.     return 1
  647.   }
  648.  
  649.   if {$revision == {}} {
  650.     catch {exec co -p $filename 2>/dev/null} view_this
  651.   } else {
  652.     catch {exec co -p$revision $filename 2>/dev/null} view_this
  653.   }
  654.   view_output "CVS File View" $view_this
  655. }
  656.  
  657. proc cvs_fileview {mcode filename revision} {
  658. #
  659. # This looks at a revision of a file from the repository without
  660. # checking it out.
  661. #
  662.   global cvs
  663.  
  664.   if {$revision == {}} {
  665.     catch {exec $cvs co -p $mcode/$filename 2>/dev/null} view_this
  666.   } else {
  667.     catch {exec $cvs co -p -r $revision $mcode/$filename 2>/dev/null} view_this
  668.   }
  669.   view_output "CVS File View" $view_this
  670. }
  671.  
  672. proc rcs_filediff {filename ver1 ver2} {
  673. #
  674. # This does a diff of an RCS file within the repository.
  675. #
  676.   if {$cvscfg(remote)} {
  677.     cvs_remote_bad
  678.     return 1
  679.   }
  680.   if {$ver1 == {} || $ver2 == {}} {
  681.     cvserror "Must have two revision numbers for this function!"
  682.     return 1
  683.   }
  684.   # catch {exec rcsdiff -r$ver1 -r$ver2 $filename} view_this
  685.   # view_output "CVS File Diff" $view_this
  686.   exec tkdiff -r$ver1 -r$ver2 $filename &
  687. }
  688.  
  689.  
  690. proc cvs_filediff {mcode filename ver1 ver2} {
  691. #
  692. # This looks at a diff of a file from the repository without
  693. # checking it out.
  694. #
  695.   global cvs
  696.   global cvsroot
  697.   global location
  698.  
  699.   rcs_filediff $cvsroot/$location($mcode)/$filename $ver1 $ver2
  700. }
  701.  
  702. proc cvs_export {mcode revision} {
  703. #
  704. # This exports a new module (see man cvs and read about export) into
  705. # the current directory.
  706. #
  707.   global cvs
  708.   global incvs
  709.   global cvscfg
  710.  
  711.   if {$incvs} {
  712.     cvs_incvs
  713.     return 1
  714.   }
  715.  
  716.   if {$cvscfg(cvsver) < 1.3} {
  717.     cvserror "This function is not supported in CVS version $cvscfg(cvsver).
  718.  
  719. Please upgrade your CVS to version 1.3"
  720.     return
  721.   }
  722.  
  723.   if {$revision == {}} {
  724.     cvserror "You must enter a tag name for this function."
  725.     return
  726.   }
  727.  
  728.   set mess "This will export $mcode from CVS.\nAre you sure?"
  729.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  730.  
  731.   if {$confirm == 0} {
  732.     catch {exec $cvs export -r $revision $mcode} view_this
  733.     view_output "CVS Export" $view_this
  734.     setup_dir
  735.   }
  736. }
  737.  
  738. proc cvs_patch {mcode revision1 revision2} {
  739. #
  740. # This creates a patch file between two revisions of a module.  If the
  741. # second revision is null, it creates a patch to the head revision.
  742. #
  743.   global cvs
  744.   global cvscfg
  745.  
  746.   if {$revision1 == {}} {
  747.     cvserror "You must enter a tag name for this function."
  748.     return
  749.   }
  750.  
  751.   set mess "This will make a patch file for $mcode from CVS.\nAre you sure?"
  752.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  753.  
  754.   if {$confirm == 0} {
  755.     if {$revision2 == {}} {
  756.       catch {exec $cvs patch -r $revision1 $mcode > $mcode.pat} view_this
  757.     } else {
  758.       catch {exec $cvs patch -r $revision1 -r $revision2 $mcode > $mcode.pat} \
  759.         view_this
  760.     }
  761.     set view_this "$view_this\n\nPatch file $mcode.pat created."
  762.     view_output "CVS Patch" $view_this
  763.     setup_dir
  764.   }
  765. }
  766.  
  767. proc cvs_patch_summary {mcode revision1 revision2} {
  768. #
  769. # This creates a patch summary of a module between 2 revisions.
  770. #
  771.   global cvs
  772.   global cvscfg
  773.  
  774.   if {$revision1 == {}} {
  775.     cvserror "You must enter a tag name for this function."
  776.     return
  777.   }
  778.  
  779.   if {$revision2 == {}} {
  780.     catch {exec $cvs patch -s -r $revision1 $mcode} view_this
  781.   } else {
  782.     catch {exec $cvs patch -s -r $revision1 -r $revision2 $mcode} view_this
  783.   }
  784.   view_output "CVS Patch Summary" $view_this
  785. }
  786.  
  787. proc cvs_version {} {
  788. #
  789. # This shows the current CVS version number.
  790. #
  791.   global cvs
  792.  
  793.   catch {exec $cvs -v} view_this
  794.   view_output "CVS Version" $view_this
  795. }
  796.  
  797. proc cvs_rtag {mcode branch tagnameA tagnameB} {
  798. #
  799. # This tags a module in the repository.
  800. #
  801.   global cvs
  802.   global cvscfg
  803.  
  804.   if {$cvscfg(cvsver) < 1.3} {
  805.     set command "tag"
  806.   } else {
  807.     set command "rtag"
  808.   }
  809.  
  810.   set cmd_options ""
  811.  
  812.   if {$branch == "yes"} {
  813.     if {$cvscfg(cvsver) < 1.3} {
  814.       set mess "This function is not supported in CVS version $cvscfg(cvsver)."
  815.       set mess "$mess\n\nPlease upgrade your CVS to version 1.3"
  816.       cvserror $mess
  817.       return
  818.     }
  819.     set cmd_options "-b"
  820.   }
  821.  
  822.   # puts stderr "Using options for CVS version $cvscfg(cvsver)"
  823.   if {$cvscfg(cvsver) > 1.3} {
  824.     set cmd_options "$cmd_options -F"
  825.   }
  826.  
  827.   if {$tagnameA == ""} {
  828.     cvserror "You must enter a tag name!"
  829.     return 1
  830.   }
  831.  
  832.   set mess "This will tag module \"$mcode\" in CVS with tag \"$tagnameA\"."
  833.   if {$tagnameB == ""} {
  834.     set mess "$mess\n\nThe head revision of all files will be tagged."
  835.   } else {
  836.     set mess "$mess\n\nThe revisions tagged with \"$tagnameB\" will be tagged."
  837.     set cmd_options "$cmd_options -r $tagnameB"
  838.   }
  839.   set mess "$mess\n\nAre you sure?"
  840.   set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  841.  
  842.   if {$confirm == 0} {
  843.     catch {eval "exec $cvs $command $cmd_options $tagnameA $mcode"} view_this
  844.     view_output "CVS Rtag" $view_this
  845.   }
  846. }
  847.  
  848. proc cvs_usercmd {args} {
  849. #
  850. # Allows the user to run a user-specified cvs command.
  851. #
  852.   global cvs
  853.  
  854.   catch {eval "exec $cvs $args"} view_this
  855.   view_output "CVS [lindex $args 0]" $view_this
  856. }
  857.  
  858. proc cvs_anycmd {args} {
  859. #
  860. # Allows the user to run any user-specified command.
  861. #
  862.   catch {eval "exec $args"} view_this
  863.   view_output [lindex $args 0] $view_this
  864. }
  865.  
  866. proc view_output {title output_string} {
  867. #
  868. # Set up a dialog containing a text box that can be used to view
  869. # the report on the screen.
  870. #
  871.   static {viewer 0}
  872.  
  873.   # If nothing to report, then say so.
  874.   # -sj
  875.   if {$output_string == ""} {
  876.     set mess "Nothing to report."
  877.     set confirm [tk_dialog .message {Confirm!} $mess warning 0 OK Quit]
  878.   } else {
  879.     incr viewer
  880.     set cvsview ".cvsview$viewer"
  881.     toplevel $cvsview
  882.     text $cvsview.text -setgrid yes -relief sunken -border 2 \
  883.       -yscroll "$cvsview.scroll set"
  884.     scrollbar $cvsview.scroll -relief sunken \
  885.       -command "$cvsview.text yview"
  886.     button $cvsview.ok -text "OK" \
  887.       -command "destroy $cvsview"
  888.  
  889.     pack $cvsview.ok -side bottom -fill x
  890.     pack $cvsview.scroll -side right -fill y -padx 2 -pady 2
  891.     pack $cvsview.text -fill both -expand 1
  892.  
  893.     wm title $cvsview "$title Output"
  894.     $cvsview.text insert end $output_string
  895.     $cvsview.text configure -state disabled
  896.   }
  897. }
  898.